home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / 3DTEXT.ZIP / 3DPLASM.PAS < prev    next >
Pascal/Delphi Source File  |  1996-06-19  |  20KB  |  928 lines
  1. uses crt;
  2. Type TE          = Record  X : Integer;
  3.                            px, py : Byte; End;
  4.      Table       = Array[0..599] of TE;
  5.      PTable      = ^Table;
  6.     tabelltype = array [0..199] of byte;
  7. const
  8.   size=80;
  9.  sinsize = 2880;
  10.       shls    = 3;
  11.   pointnum=7;
  12.   planenum=5;
  13.   points:array[0..pointnum,0..2] of integer=(
  14.     (-size,-size,-size),( size,-size,-size),( size, size,-size),(-size, size,-size),
  15.     (-size,-size, size),( size,-size, size),( size, size, size),(-size, size, size));
  16.   planes:array[0..planenum,0..3] of byte=(
  17.     (0,1,2,3),(5,4,7,6),(1,5,6,2),(4,0,3,7),
  18.     (3,2,6,7),(4,5,1,0));
  19.  
  20. var
  21.     bitmap     : array[0..79,0..49] of byte;
  22.     facx       : real;
  23.     sizecounter: word;
  24.     facy       : real;
  25.     offsetx    : real;
  26.     offsety    : real;
  27.     textbuffer : pointer;
  28.     txtbuff    : word;
  29.     TEXTF      : string[17];
  30.     t,t2,t3,t4 : word;
  31.     tab1,tab2  : array[0..511] of byte;
  32.     moded      : array[0..255] of byte;
  33.     color      : byte;
  34.     y80        : array[0..50] of word;
  35.     i1,j1      : byte;
  36.     a1,a2      : word;
  37.     i4,j5      : byte;
  38.     a4,a5      : word;
  39.     i2,j2      : word;
  40.     c,qc       : word;
  41.   xSpeed:       word;
  42.   ySpeed:       word;
  43.   zSpeed:       word;
  44.  
  45.   mathattribute:byte;
  46.   SinCalced:    ARRAY[0..sinsize] OF Integer;
  47.   CosCalced:    ARRAY[0..sinsize] OF Integer;
  48.   Counter:    Word;
  49.   hiddengrad:   Integer;
  50.   FullTurn:    Real;
  51.   BufferR:    Real;
  52.   BufferW:    Integer;
  53.   RotAngleX:    Word;
  54.   RotAngleY:    Word;
  55.   RotAngleZ:    Word;
  56.   VpDistance:   Word;
  57.   PointX3D:     Integer;
  58.   PointY3D:     Integer;
  59.   PointZ3D:     Integer;
  60.   PointX2D:     Integer;
  61.   PointY2D:     Integer;
  62.   SiX:          Integer;
  63.   SiY:          Integer;
  64.   SiZ:          Integer;
  65.   CoX:          Integer;
  66.   CoY:          Integer;
  67.   CoZ:          Integer;
  68.  
  69.     unicolor                      : byte;
  70.     pxstep,pystep                 : integer;
  71.     pxval ,pyval                  : integer;
  72.     o1                            : integer;
  73.     count                         : integer;
  74.     b                             : byte;
  75.     Left, Right                   : Table;
  76.     point                         : array[0..pointnum] of record x,y,z :integer; end;
  77.     col                           : array[0..5] of byte;
  78.     x,y,z                         : word;
  79.     r,g                           : byte;
  80.     f                             : text;
  81.     x1,x2,y1,y2                   : integer;
  82.     hy1,hy2,hx1,hx2               : char;
  83.     x1p,x2p                       : shortint;
  84.     y1p,y2p                       : shortint;
  85.  
  86. FUNCTION PcSin(Angle: Integer): Integer;
  87. BEGIN
  88.   asm
  89.     mov  ax,angle
  90.     cmp  ax,sinsize
  91.     jng  @@mindre
  92.   @@back1:
  93.     sub  ax,sinsize
  94.     cmp  ax,sinsize
  95.     jg   @@back1
  96.     jmp  @@storre
  97.   @@mindre:
  98.     cmp  ax,0
  99.     jnl  @@storre
  100.   @@back2:
  101.     add  ax,sinsize
  102.     cmp  ax,0
  103.     jl   @@back2
  104.   @@storre:
  105.     sal  ax,1
  106.     mov  si,offset sincalced
  107.     add  si,ax
  108.     lodsw
  109.     mov  angle,ax
  110.   end;{}
  111.   PcSin:=Angle;
  112. END;
  113.  
  114. FUNCTION PcCos(Angle: Integer): Integer;
  115. BEGIN
  116.   asm
  117.     mov  ax,angle
  118.     cmp  ax,sinsize
  119.     jng  @@mindre
  120.   @@back1:
  121.     sub  ax,sinsize
  122.     cmp  ax,sinsize
  123.     jg   @@back1
  124.     jmp  @@storre
  125.   @@mindre:
  126.     cmp  ax,0
  127.     jnl  @@storre
  128.   @@back2:
  129.     add  ax,sinsize
  130.     cmp  ax,0
  131.     jl   @@back2
  132.   @@storre:
  133.     mov  angle,ax
  134.     sal  ax,1
  135.     mov  si,offset coscalced
  136.     add  si,ax
  137.     lodsw
  138.     mov  angle,ax
  139.   end;{}
  140.   PcCos:=Angle;
  141. eND;
  142. FUNCTION  GetPointX3D: Integer;
  143. BEGIN
  144.   GetPointX3D:=PointX3D;
  145. END;
  146.  
  147.  
  148. PROCEDURE GenRotAngles;
  149. BEGIN
  150.   ASM
  151.     xor dx,dx
  152.     mov ax, RotAngleX
  153.     mov dx, xspeed
  154.     add ax, dx         {Increase angle around X axis}
  155.     cmp ax, sinsize         {Full rotation yet?}
  156.     jb @@10             {No, go on}
  157.     sub ax, sinsize         {Yes, subtract 360 degrees}
  158.     @@10:
  159.     mov RotAngleX, ax
  160.     mov dx, yspeed
  161.     mov ax, RotAngleY
  162.     add ax, dx          {Increase angle around Y axis}
  163.     cmp ax, sinsize     {Full rotation yet?}
  164.     jb @@20             {No, go on}
  165.     sub ax, sinsize     {Yes, subtract sinsize degrees}
  166.     @@20:
  167.     mov RotAngleY, ax
  168.     mov ax, RotAngleZ
  169.     mov dx, zspeed
  170.     add ax, dx          {Increase angle around Z axis}
  171.     cmp ax, sinsize         {Full rotation yet?}
  172.     jb @@30             {No, go on}
  173.     sub ax, sinsize         {Yes, subtract sinsize degrees}
  174.     @@30:
  175.     mov RotAngleZ, ax
  176.   END;
  177.   SiX:=PcSin(RotAngleX);
  178.   SiY:=PcSin(RotAngleY);
  179.   SiZ:=PcSin(RotAngleZ);
  180.   CoX:=PcCos(RotAngleX);
  181.   CoY:=PcCos(RotAngleY);
  182.   CoZ:=PcCos(RotAngleZ);
  183. END;
  184.  
  185.  
  186.  
  187.  
  188. function getchar(x,y,segment:word) :char;
  189. var temp:char;
  190. begin
  191.   asm
  192.     mov ax,y
  193.     shl ax,4
  194.     mov bx,ax
  195.     shl ax,2
  196.     add ax,bx
  197.     add ax,x
  198.     mov es,segment
  199.     mov si,ax
  200.     mov al,[es:si]
  201.     mov temp,al
  202.   end;
  203.   getchar:=temp;
  204. end;
  205.  
  206. PROCEDURE SetRotatespeed(NewXSpeed,NewYSpeed,NewZSpeed:word);
  207. assembler;
  208. asm
  209.   mov   ax,newxspeed
  210.   mov   xspeed,ax
  211.   mov   ax,newyspeed
  212.   mov   yspeed,ax
  213.   mov   ax,newzspeed
  214.   mov   zspeed,ax
  215. end;
  216.  
  217. PROCEDURE SetPoint(NewPointX3D, NewPointY3D, NewPointZ3D: Integer); ASSEMBLER;
  218. ASM
  219. { next up : x2d = (x3d*zoom)/(z+dist)}
  220.   mov  ax, NewPointX3D
  221.   mov  PointX3D, ax
  222.   mov  ax, NewPointY3D
  223.   mov  PointY3D, ax
  224.   mov  ax, NewPointZ3D
  225.   mov  PointZ3D, ax
  226.  
  227.   mov  ax, PointY3D   {Do X axis rotation}
  228.   imul Cox
  229.   sar  ax, 7
  230.   mov  bx, ax
  231.  
  232.   mov  ax, PointZ3D
  233.   imul SiX
  234.   sar  ax, 7
  235.   add  ax, bx
  236.   mov  cx, ax   {cx holds new NY}
  237.  
  238.   mov  ax, PointZ3D
  239.   imul CoX
  240.   sar  ax, 7
  241.   mov  bx, ax
  242.  
  243.   mov  ax, PointY3D
  244.   imul SiX
  245.   sar  ax, 7
  246.   sub  bx, ax   {bx holds new NZ}
  247.   mov  PointZ3D, bx
  248.   mov  PointY3D, cx
  249.  
  250.   mov  ax, PointX3D   {Do Y axis rotation}
  251.   imul CoY
  252.   sar  ax, 7
  253.   mov  bx, ax
  254.  
  255.   mov  ax, PointZ3D
  256.   imul SiY
  257.   sar  ax, 7
  258.   sub  bx, ax
  259.   mov  cx, bx   {cx holds new NX}
  260.  
  261.   mov  ax, PointX3D
  262.   imul SiY
  263.   sar  ax, 7
  264.   mov  bx, ax
  265.  
  266.   mov  ax, PointZ3D
  267.   imul CoY
  268.   sar  ax, 7
  269.   add  ax, bx   {ax holds new NZ}
  270.   mov  PointX3D, cx
  271.   mov  PointZ3D, ax
  272.  
  273.   mov  ax, PointX3D   {Do Z axis rotation}
  274.   imul CoZ
  275.   sar  ax, 7
  276.   mov  bx, ax
  277.  
  278.   mov  ax, PointY3D
  279.   imul SiZ
  280.   sar  ax, 7
  281.   add  ax, bx
  282.   mov  cx, ax   {cx holds new NX}
  283.  
  284.   mov  ax, PointY3D
  285.   imul CoZ
  286.   sar  ax, 7
  287.   mov  bx, ax
  288.  
  289.   mov  ax, PointX3D
  290.   imul SiZ
  291.   sar  ax, 7
  292.   sub  bx, ax   {bx holds new NY}
  293.   mov  PointY3D, bx
  294.   mov  PointX3D, cx
  295.  
  296. {  asx = (x3d*zoom)/(z+dist)}
  297.  
  298. {  neg    pointx3d
  299.   neg    pointy2d
  300.   mov    ax,pointx3d
  301.   mov    bx,zoom
  302.   imul   bx
  303.   mov    cx,pointz3d
  304.   add    cx,Vpdistance
  305.   idiv   cx
  306.   add    ax,160
  307.   mov    pointx2d,ax
  308.   mov    ax,pointy3d
  309.   mov    bx,zoom
  310.   imul   bx
  311.   mov    cx,pointz3d
  312.   add    cx,vpdistance
  313.   idiv   cx
  314.   add    ax,100
  315.   mov    pointy2d,ax}
  316.  
  317.   mov   cx, PointZ3D
  318.   add   cx, VpDistance
  319.   add   cx,100
  320.   mov   ax, PointX3D
  321.   cmp   cx,0
  322.   je    @@divzero
  323.   imul  VpDistance
  324.   idiv  cx
  325.   mov   PointY2D, ax
  326.   mov   bx,100
  327.   add   PointY2D, bx
  328.   mov   ax, PointY3D
  329.   imul  VpDistance
  330.   cmp   cx,0
  331.   je    @@divzero
  332.   idiv  cx
  333.   mov   PointX2D, ax
  334.   mov   bx,160
  335.   add   PointX2D, bx
  336. @@divzero:
  337. END;
  338.  
  339. PROCEDURE InitMath3D;
  340. BEGIN
  341.   VpDistance:=250;
  342.   xspeed:=3;
  343.   yspeed:=6;
  344.   zspeed:=9;
  345.   RotAngleX:=0;
  346.   RotAngleY:=0;
  347.   RotAngleZ:=0;
  348.   PointX3D:=0;
  349.   PointY3D:=0;
  350.   PointZ3D:=0;
  351.   PointX2D:=0;
  352.   PointY2D:=0;
  353.   FullTurn:=2*Pi;
  354.   FOR Counter:=0 TO sinsize DO
  355.   BEGIN
  356.     BufferR:=Sin((Fullturn*Counter)/sinsize);
  357.     BufferW:=round(BufferR*128);
  358.     SinCalced[Counter]:=BufferW;
  359.   END;
  360.   FOR Counter:=0 TO sinsize DO
  361.   BEGIN
  362.     BufferR:=Cos((Fullturn*Counter)/sinsize);
  363.     BufferW:=round(BufferR*128);
  364.     CosCalced[Counter]:=BufferW;
  365.   END;
  366.   SiX:=PcSin(RotAngleX shl shls);
  367.   SiY:=PcSin(RotAngleY shl shls);
  368.   SiZ:=PcSin(RotAngleZ shl shls);
  369.   CoX:=PcCos(RotAngleX shl shls);
  370.   CoY:=PcCos(RotAngleY shl shls);
  371.   CoZ:=PcCos(RotAngleZ shl shls);
  372. END;
  373.  
  374.  
  375.  
  376. procedure getrotangles(var anglex,angley,anglez:word);
  377. begin
  378.   anglex:=rotanglex div 8;
  379.   angley:=rotangley div 8;
  380.   anglez:=rotanglez div 8;
  381. end;
  382.  
  383. PROCEDURE SetRotAngles(NewAngleX, NewAngleY, NewAngleZ: Word);
  384. BEGIN
  385.   ASM
  386.     mov  ax, NewAngleX
  387.     sal  ax, shls
  388.     mov  RotAngleX, ax
  389.     mov  ax, NewAngleY
  390.     sal  ax, shls
  391.     mov  RotAngleY, ax
  392.     mov  ax, NewAngleZ
  393.     sal  ax, shls
  394.     mov  RotAngleZ, ax
  395.   end;
  396.   SiX:=PcSin(RotAngleX);
  397.   SiY:=PcSin(RotAngleY);
  398.   SiZ:=PcSin(RotAngleZ);
  399.   CoX:=PcCos(RotAngleX);
  400.   CoY:=PcCos(RotAngleY);
  401.   CoZ:=PcCos(RotAngleZ);
  402. END;
  403.  
  404.  
  405. PROCEDURE RETRACE;
  406. ASSEMBLER;
  407. ASM
  408.   mov dx,3dah
  409.  @@vert1:
  410.   in al,dx
  411.   test al,8
  412.   jz @@vert1
  413.  @@vert2:
  414.   in al,dx
  415.   test al,8
  416.   jnz @@vert2
  417. END;
  418.  
  419. procedure clrscr2;
  420. assembler;
  421. asm
  422.   mov es,txtbuff
  423.   xor di,di
  424.   mov cx,2080*2
  425.   xor ax,ax
  426.   rep stosw
  427. end;
  428.  
  429. procedure flip;
  430. assembler;
  431. asm
  432.   mov ax,0b800h
  433.   mov es,ax
  434.   mov dx,ds
  435.   mov ax,txtbuff
  436.   mov ds,ax
  437.   xor si,si
  438.   xor di,di
  439.   mov cx,2080*2
  440.   rep movsw
  441.   mov ds,dx
  442. end;
  443.  
  444. procedure plotxy(position:word;x,y:byte;value:char;color:byte;segment:word);
  445. assembler;
  446. asm
  447.   mov si,position
  448.   cmp si,65535
  449.   jne @@pos
  450.   xor dh,dh
  451.   mov dl,y
  452.   shl dx,4
  453.   mov ax,dx
  454.   shl dx,2
  455.   add dx,ax
  456.   mov al,x
  457.   xor ah,ah
  458.   add dx,ax
  459.   mov si,dx
  460. @@pos:
  461.   mov es,segment
  462.   mov al,value
  463.   mov ah,color
  464.   shl si,1
  465.   mov [es:si],ax
  466. end;
  467.  
  468.  
  469. procedure switch(one,two:longint);
  470. var temp:longint;
  471. begin
  472.   temp:=one;
  473.   one:=two;
  474.   two:=temp;
  475. end;
  476.  
  477. Procedure TextureHLine(X1, X2, px1, py1, px2, py2, Y : Integer; Dim : Word);
  478. var tt1,tt2,tt3:integer;
  479. Begin
  480.   asm
  481.    sub y,200
  482.    mov bx,x2
  483.    sub bx,x1
  484.    inc bx
  485.    mov tt1,bx
  486.  
  487.    mov ax,px2
  488.    sub ax,px1
  489.    shl ax,8
  490.    mov tt2,ax
  491.  
  492.    mov ax,py2
  493.    sub ax,py1
  494.    shl ax,8
  495.    mov tt3,ax
  496.   end;
  497.   pxStep := tt2 Div tt1;
  498.   pyStep := tt3 Div tt1;
  499.   asm
  500.    mov bx, px1
  501.    shl bx, 8
  502.    mov pxval,bx  {  pxVal := px1 Shl 8;}
  503.    mov bx, py1
  504.    shl bx, 8
  505.    mov pyval,bx  {  pyVal := py1 Shl 8;}
  506.    mov ax,y
  507.    shl ax,4
  508.    mov di,ax
  509.    shl ax,2
  510.    add di,ax
  511.    add di,x1
  512.    mov o1, di
  513.   End;
  514.   For Count := X1 to X2 do
  515.     Begin
  516.      b:=Bitmap[Hi(pxVal),Hi(pyVal)];
  517.      if ( count<80 ) and ( y<50 ) then
  518.      plotxy(65535,count,y,chr(b),unicolor,txtbuff);
  519.      Asm
  520.        mov ax, pxval
  521.        add ax, pxstep
  522.        mov pxval, ax
  523.        mov ax, pyval
  524.        add ax, pystep
  525.        mov pyval, ax
  526.        inc o1
  527.      end;
  528.   End;
  529. End;
  530.  
  531. Procedure Swap(Var A, B : Integer);
  532. Var t : Integer;
  533. Begin
  534.   t := a;
  535.   a := b;
  536.   b := t;
  537. End;
  538.  
  539. Procedure Texture(X1, Y1, X2, Y2, X3, Y3, X4, Y4 : Integer; Dim : Byte);
  540. Var yMin, yMax             : Integer;
  541.     xStart, xEnd           : Integer;
  542.     yStart, yEnd           : Integer;
  543.     pxStart, pxEnd         : Integer;
  544.     pyStart,pyEnd          : Integer;
  545.     XVal, XStep            : Longint;
  546.     pxVal, pxStep          : Integer;
  547.     pyVal, pyStep          : Integer;
  548.     Count                  : Integer;
  549.     Side                   : PTable;
  550. Begin
  551.   asm
  552.     add y1,200
  553.     add y2,200
  554.     add y3,200
  555.     add y4,200
  556.  
  557.     mov ax,y1
  558.     mov ymin,ax
  559.     mov ax,y1
  560.     mov ymax,ax
  561.     mov ax,y2
  562.     cmp ax,ymax
  563.     jl  @@nabove1
  564.     mov ymax,ax
  565.   @@nabove1:
  566.     mov ax,y3
  567.     cmp ax,ymax
  568.     jl  @@nabove2
  569.     mov ymax,ax
  570.   @@nabove2:
  571.     mov ax,y4
  572.     cmp ax,ymax
  573.     jl  @@nabove3
  574.     mov ymax,ax
  575.   @@nabove3:
  576.     mov ax,y2
  577.     cmp ax,ymin
  578.     ja @@above1
  579.     mov ymin,ax
  580.   @@above1:
  581.     mov ax,y3
  582.     cmp ax,ymin
  583.     ja @@above2
  584.     mov ymin,ax
  585.   @@above2:
  586.     mov ax,y4
  587.     cmp ax,ymin
  588.     ja @@above3
  589.     mov ymin,ax
  590.   @@above3:
  591.     mov ax,x1
  592.     mov xstart,ax
  593.     mov ax,y1
  594.     mov ystart,ax
  595.     mov ax,x2
  596.     mov xend,ax
  597.     mov ax,y2
  598.     mov yend,ax
  599.     mov pxstart,0
  600.     mov pystart,0
  601.     mov al,[dim]
  602.     dec al
  603.     xor ah,ah
  604.     mov pxend,ax
  605.     mov pyend,0
  606.   end;
  607.   If yStart > yEnd Then
  608.   Begin
  609.     Swap(xStart, xEnd);
  610.     Swap(yStart, yEnd);
  611.     Swap(pxStart, pxEnd);
  612.     Side := @Left;
  613.   End
  614. Else
  615.   Side := @Right;
  616.   XVal := Longint(xStart) Shl 8;
  617.   XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  618.   pxVal := pxStart Shl 8;
  619.   pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1);
  620.   For Count := yStart to yEnd do
  621.     Begin
  622.       Side^[Count].x := XVal Shr 8;
  623.       Side^[Count].px := pxVal Shr 8;
  624.       Side^[Count].py := pyStart;
  625.       XVal := XVal + XStep;
  626.       pxVal := pxVal + pxStep;
  627.     End;
  628.     xStart := X2;
  629.     yStart := Y2;
  630.     xEnd := X3;
  631.     yEnd := Y3;
  632.     pxStart := Dim-1;
  633.     pyStart := 0;
  634.     pxEnd := Dim-1;
  635.     pyEnd := Dim-1;
  636.    If yStart > yEnd Then
  637.    Begin
  638.      Swap(xStart, xEnd);
  639.      Swap(yStart, yEnd);
  640.      Swap(pyStart, pyEnd);
  641.      Side := @Left;
  642.    End
  643.    Else Side := @Right;
  644.   XVal := Longint(xStart) Shl 8;
  645.   XStep:=(Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  646.   pyVal := pyStart Shl 8;
  647.   pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1);
  648.   For Count := yStart to yEnd do
  649.     Begin
  650.       Side^[Count].x := XVal Shr 8;
  651.       Side^[Count].py := pyVal Shr 8;
  652.       Side^[Count].px := pxStart; XVal := XVal + XStep;
  653.       pyVal := pyVal + pyStep;
  654.     End;
  655.   xStart := X3;
  656.   yStart := Y3;
  657.   xEnd := X4;
  658.   yEnd := Y4;
  659.   pxStart := Dim-1;
  660.   pyStart := Dim-1;
  661.   pxEnd := 0;
  662.   pyEnd := Dim-1;
  663.   If yStart > yEnd Then
  664.   Begin
  665.     Swap(xStart, xEnd);
  666.     Swap(yStart, yEnd);
  667.     Swap(pxStart, pxEnd);
  668.     Side := @Left;
  669.   End
  670. Else
  671.   Side := @Right;
  672.   XVal := Longint(xStart) Shl 8;
  673.   XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  674.   pxVal := pxStart Shl 8;
  675.   pxStep := ((pxEnd-pxStart) Shl 8) Div (yEnd-yStart+1);
  676.   For Count := yStart to yEnd do
  677.     Begin
  678.       Side^[Count].x := XVal Shr 8;
  679.       Side^[Count].px := pxVal Shr 8;
  680.       Side^[Count].py := pyStart;
  681.       XVal := XVal + XStep;
  682.       pxVal := pxVal + pxStep;
  683.     End;
  684.   xStart := X4;
  685.   yStart := Y4;
  686.   xEnd := X1;
  687.   yEnd := Y1;
  688.   pxStart := 0;
  689.   pyStart := Dim-1;
  690.   pxEnd := 0;
  691.   pyEnd := 0;
  692.   If yStart > yEnd Then
  693.   Begin
  694.     Swap(xStart, xEnd);
  695.     Swap(yStart, yEnd);
  696.     Swap(pyStart, pyEnd);
  697.     Side := @Left;
  698.   End
  699. Else
  700.   Side := @Right;
  701.   XVal := Longint(xStart) Shl 8;
  702.   XStep := (Longint(xEnd-xStart) Shl 8) Div (yEnd-yStart+1);
  703.   pyVal := pyStart Shl 8;
  704.   pyStep := ((pyEnd-pyStart) Shl 8) Div (yEnd-yStart+1);
  705.   For Count := yStart to yEnd do
  706.   Begin Side^[Count].x := XVal Shr 8;
  707.     Side^[Count].py := pyVal Shr 8;
  708.     Side^[Count].px := pxStart;
  709.     XVal := XVal + XStep;
  710.     pyVal := pyVal + pyStep;
  711.   End;
  712.   For Count := yMin to yMax do
  713.     if (count>199) and (count<400) then
  714.     If Left[Count].x < Right[Count].x
  715.       Then TextureHLine(Left[Count].x, Right[Count].x, Left[Count].px, Left[Count].py,
  716.               Right[Count].px, Right[Count].py, Count, Dim)
  717.       Else TextureHLine(Right[Count].x, Left[Count].x, Right[Count].px, Right[Count].py,
  718.               Left[Count].px, Left[Count].py, Count, Dim);
  719. End;
  720.  
  721. function moded255(value:integer):byte;
  722. begin
  723.   repeat
  724.     if value<0 then inc(value,255);
  725.     if value>255 then dec(value,255);
  726.   until (value>=0) and (value<=255);
  727.   moded255:=moded[value];
  728. end;
  729.  
  730. PROCEDURE Syncronize;
  731. ASSEMBLER;
  732. ASM
  733.     @@Tester:
  734.     mov     DX,3DAh
  735.     in      AL,DX
  736.     test    AL,1000b
  737.     jz      @@Tester
  738. END;
  739.  
  740. procedure initprog;
  741. begin
  742.   for t:=0 to 50 do y80[t]:=t*80;
  743.   getmem(textbuffer,8000);
  744.   txtbuff:=seg(textbuffer^);
  745.   for t:=0 to 511 do
  746.   begin
  747.     tab1[t]:=round(sin(2*pi*t/255)*30)+15;
  748.     tab2[t]:=round(cos(2*pi*t/255)*30)+15;
  749.   end;
  750.   i1:=50;
  751.   j1:=90;
  752.   for t:=0 to 255 do moded[t]:=t mod 255;
  753. end;
  754.  
  755.  
  756. procedure plot(position:word; value:char;color:byte);
  757. assembler;
  758. asm
  759.   mov ax,txtbuff
  760.   mov es,ax
  761.   mov al,value
  762.   mov ah,color
  763.   mov si,position
  764.   shl si,1
  765.   mov [es:si],ax
  766. end;
  767.  
  768. PROCEDURE Cursor(On: Boolean);
  769. BEGIN
  770.   IF On=FALSE THEN
  771.   BEGIN
  772.   ASM
  773.     mov  ah, 01h
  774.     mov  cl, 20h
  775.     mov  ch, 20h
  776.     int  10h
  777.   END;
  778.   END
  779.   ELSE
  780.   BEGIN
  781.   ASM
  782.     mov  ah, 01h
  783.     mov  cl, 06h
  784.     mov  ch, 07h
  785.     int  10h
  786.   END;
  787. END;
  788. END;
  789.  
  790. function changecol :char;
  791. begin
  792.         case (c mod 16) of
  793.         0  : begin changecol:=' '; color:=black;  end;
  794.         1  : begin changecol:=' '; color:=lightgray; end;
  795.         2  : begin changecol:='░'; color:=lightgray; end;
  796.         3  : begin changecol:='░'; color:=lightgray; end;
  797.         4  : begin changecol:='▒'; color:=lightgray; end;
  798.         5  : begin changecol:='▒'; color:=lightgray; end;
  799.         6  : begin changecol:='▓'; color:=lightgray; end;
  800.         7  : begin changecol:='▓'; color:=lightgray; end;
  801.         8  : begin changecol:='█'; color:=lightgray; end;
  802.         9  : begin changecol:='█'; color:=lightgray; end;
  803.         10 : begin changecol:='▓'; color:=lightgray; end;
  804.         11 : begin changecol:='▓'; color:=lightgray; end;
  805.         12 : begin changecol:='▒'; color:=lightgray; end;
  806.         13 : begin changecol:='▒'; color:=lightgray; end;
  807.         14 : begin changecol:='░'; color:=lightgray; end;
  808.         15 : begin changecol:='░'; color:=lightgray; end;
  809.         end;
  810. end;
  811.  
  812. procedure mainprog;
  813. var cc    : char;
  814. begin
  815.   a1:=0;
  816.   a2:=0;
  817.     asm
  818.       mov ax,a1
  819.       add ax,274
  820.       mov i1,ah
  821.       mov a1,ax
  822.       mov ax,a2
  823.       add ax,324
  824.       mov j1,ah
  825.       mov a2,ax
  826.  
  827.       mov ax,a4
  828.       add ax,395
  829.       mov i4,ah
  830.       mov a4,ax
  831.       mov ax,a5
  832.       add ax,257
  833.       mov j5,ah
  834.       mov a5,ax
  835.     end;
  836.     for y:=0 to 49 do begin
  837.       i2:=tab1[moded255(j2-i1)];
  838.       j2:=tab2[moded255(j1+j5)];
  839.       for x:=0 to 79 do
  840.       begin
  841.         qc:=tab1[moded255(i1+y)]+tab1[moded255(j5-x)];
  842.         c:=tab2[moded255(i2-y+i4)]+tab2[moded255(qc+x)];
  843.         bitmap[x,y]:=ord(changecol);
  844.       end;
  845.     end;
  846. end;
  847.  
  848. FUNCTION  GetPointZ3D: Integer;
  849. BEGIN
  850.   GetPointZ3D:=PointZ3D;
  851. END;
  852.  
  853. FUNCTION  GetPointX2D: integer;
  854. BEGIN
  855.   GetPointX2D:=PointX2D;
  856. END;
  857.  
  858. FUNCTION  GetPointY2D: integer;
  859. BEGIN
  860.   GetPointY2D:=PointY2D;
  861. END;
  862.  
  863.  
  864. FUNCTION  HIDDEN(X1,Y1,X2,Y2,X3,Y3:INTEGER) :BOOLEAN;
  865. BEGIN
  866.   HIDDEN:=FALSE;
  867.   hiddengrad:=(x3-x1)*(y2-y1)-(x2-x1)*(y3-y1);
  868.   if hiddengrad<1 then HIDDEN:=TRUE;
  869. END;
  870.  
  871.  
  872. procedure chksize;
  873. begin
  874.   if sizecounter<700 then  inc(sizecounter);
  875.   if (sizecounter>400) and (sizecounter<500)then
  876.   begin
  877.     facx:=facx+0.016;
  878.     facy:=facy+0.018;
  879.     offsety:=offsety+0.5;
  880.     offsetx:=offsetx+0.8;
  881.   end;
  882.   if sizecounter=400 then setrotatespeed(3,12,7);
  883. end;
  884.  
  885. begin
  886.   textmode(258);
  887.   clrscr;
  888.   textcolor(white);
  889.   textbackground(black);
  890.   offsetx:=0;
  891.   offsety:=-10;
  892.   facx:=4;
  893.   facy:=4;
  894.   unicolor:=blue;
  895.   initprog;
  896.   initmath3d;
  897.   setrotatespeed(5,12,7);
  898.   sizecounter:=0;
  899.   repeat
  900.     mainprog;
  901.     retrace;
  902.     flip;
  903.     clrscr2;
  904.     genrotangles;
  905.     for t:=0 to pointnum do
  906.     begin
  907.       setpoint(points[t,0],points[t,1],points[t,2]);
  908.       point[t].x:=getpointx2d+trunc(offsetx);
  909.       point[t].y:=getpointy2d+trunc(offsety);
  910.       point[t].z:=abs(round(getpointz3d*1.6));
  911.     end;
  912.     for t:=0 to planenum do
  913.       if not hidden(point[planes[t,0]].x,point[planes[t,0]].y,
  914.                 point[planes[t,1]].x,point[planes[t,1]].y,
  915.                 point[planes[t,2]].x,point[planes[t,2]].y) then
  916.       begin
  917.         unicolor:=t+1;
  918.         texture(round(point[planes[t,0]].x/facx),round(point[planes[t,0]].y/facy),
  919.                 round(point[planes[t,1]].x/facx),round(point[planes[t,1]].y/facy),
  920.                 round(point[planes[t,2]].x/facx),round(point[planes[t,2]].y/facy),
  921.                 round(point[planes[t,3]].x/facx),round(point[planes[t,3]].y/facy),50);
  922.       end;
  923.   until keypressed;
  924.   freemem(textbuffer,8000);
  925. end.
  926.  
  927. Made by The Joker of crusaders.  This was used in a 
  928. part of his winning "ringnes motion". Spread at will.